perm filename PASS3[900,BGB] blob
sn#129562 filedate 1974-11-11 generic text, type T, neo UTF8
00100 TITLE PASS3
00200 EXTERNAL TRIBLKS,TRITAB,INPUT3,NUMTRI
00300 INTERNAL PASS3
00400 PASS3: 0
00500 SETZM NLEAST# ;COUNT OF TRIANGLES
00550 OPDEF OUTSTG [XWD 051140,0]
00600 ;ACCUMULATORS
00700 A←←XY1←←KA←←0
00800 B←←XY2←←AC0←←LA←←1
00900 C←←XY3←←AC1←←2
01000 AA←←I1←←Z12←←LO←←LB←←KB←←3
01100 BB←←I2←←Z3I←←HI←←4
01200 CC←←I3←←C12←←MID←←5
01300 X1←←AB1←←KC←←6
01400 X2←←AB2←←7
01500 X3←←AB3←←10
01600 Y1←←AB←←11
01700 Y2←←CC3←←12
01800 Y3←←13
01900 Z1←←Z←←14
02000 Z2←←TRI←←15
02100 Z3←←LC←←16
02200 ZT←←QB←←II←←KK←←17
02240 KPLANE←20000
02300 LOOP: MOVE QB,NLEAST ;DONE YET
02400 CAML QB,NUMTRI
02500 JRST @PASS3
02600 ;BLIT TRIANGLE BLOCK INTO AC'S
02700 IMULI QB,5
02800 ADDI QB,INPUT3
02840 MOVSS QB
02900 BLT QB,4
03000 ;UNPACK TRIANGLE BLOCK
03100 FOR @$ I←1,3 {
03200 HLRE X$I,XY$I
03300 HRRE Y$I,XY$I ⎇
03400 HLRE Z1,Z12
03500 HRRE Z2,Z12
03600 HLRE Z3,Z3I
03700 HRRZ II,Z3I
03800 P3B:
03900 TRNE II,4 ↔ SKIPA I1,[1] ↔ SETZ I1,
04000 TRNE II,2 ↔ SKIPA I2,[1] ↔ SETZ I2,
04100 TRNE II,1 ↔ SKIPA I3,[1] ↔ SETZ I3,
04200 P3A:
04300 ;ORDER Z1 LEAST, Z3 MOST.
04400 DEFINE SWAP $ (N,M) {
04500 CAMG Z$N,Z$M
04600 JRST .+5
04700 EXCH X$N,X$M
04800 EXCH Y$N,Y$M
04900 EXCH Z$N,Z$M
05000 EXCH I$N,I$M ⎇
05100 SWAP 1,2
05200 SWAP 2,3
05300 SWAP 1,2
05400
05500 MOVE II,I1 ;RE-PACK I-BITS
05600 LSH II,1
05700 IOR II,I2
05800 LSH II,1
05900 IOR II,I3
06000
06100 EXCH II,[KPLANE]
00100 ;CALCULATE COEFFICIENTS OF THE PLANE OF THE TRIANGLE BY KRAMER'S RULE.
00200 DEFINE DET2B2 (A00,B11,B12,B21,B22) {
00300 MOVE B,B11
00400 MOVE C,B12
00500 IMUL B,B22
00600 IMUL C,B21
00700 SUB B,C
00800 IMUL B,A00 ⎇
00900
01000 DEFINE DETERM (A11,A12,A13,A21,A22,A23,A31,A32,A33) {
01100 DET2B2 A11,A22,A23,A32,A33
01200 MOVE A,B
01300 DET2B2 A12,A21,A23,A31,A33
01400 SUB A,B
01500 DET2B2 A13,A21,A22,A31,A32
01600 ADD A,B ⎇
01700
01800 DETERM KK,Y1,Z1,KK,Y2,Z2,KK,Y3,Z3
01900 MOVE AA,A
02000 DETERM X1,KK,Z1,X2,KK,Z2,X3,KK,Z3
02100 MOVE BB,A
02200 DETERM X1,Y1,KK,X2,Y2,KK,X3,Y3,KK
02300 MOVE CC,A
02400 DETERM X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3
02410 MOVE B,A
02420 MOVE C,A
02500 IDIVM AA,A
02600 IDIVM BB,B
02700 IDIVM CC,C
02710 MOVE CC,C
02720 MOVE BB,B
02730 MOVE AA,A
02731 ;HALF WORD OVERFLOW DETECTION, WARNING AND RESET TO MAXIMUM HALF
02733 ;WORD VALUE.
02735 DEFINE HALFOV (W,WW){
02745 MOVMS W,WW
02747 CAIGE W,400000
02749 JRST .+5
02751 SKIPL WW ;OVERFLOW
02753 SKIPA WW,377777
02755 SKIP WW,400000
02757 OUTSTG [ASCIZ/ HALF-WORD OVERFLOW WARNING.
02759 /]
02761 ⎇
02763 HALFOV A,AA
02765 HALFOV B,BB
02767 HALFOV C,CC
02800 P3C:
02900 ;PACK PLANE COEFFICIENTS
03000 HRL BB,AA
03100 HRLS CC
03200 EXCH KK,[KPLANE] ;COL-1
03300
03400 ;CALCULATE LINE COEFFICIENTS
03500 DEFINE LINCOE (X1,X2,Y1,Y2,TA,TB,TC) {
03600 MOVE TA,Y2
03700 MOVE TB,X1
03800 SUB TA,Y1
03900 SUB TB,X2
04000 HRL TC,TA
04100 HRR TC,TB
04200 IMUL TA,X1
04300 IMUL TB,Y1
04400 ADD TA,TB
04500 MOVNS TA
04510 MOVM TB,TA
04536 CAIGE TB,400000
04538 JRST .+6
04540 HLRE TA,TC ;HALFWORD OVERFLOW CURE
04542 HRRE TB,TC
04544 ASH TA,-1
04546 ASH TB,-1
04548 JRST .-15 ;JUMP TO THE "HRL" ABOVE.
04600 ⎇
04700 HRL QB,Z3
04800 LINCOE X1,X2,Y1,Y2,A,B,C
04900 LINCOE X1,X3,Y1,Y3,LA,LB,LC ;COL-2
05000 HRR CC,A ;PACK c3
05100 HRL Y1,X1 ;PACK X1,,Y1 ;COL-3
05200 LINCOE X2,X3,Y2,Y3,KA,KB,KC ;COL-4
05300 P3D:
05400 ;PACK EVERYTHING INTO YOUR OLD KIT BAG AND SMILE SMILE SMILE
05500 ; WOULD YOU BELIEVE A LONG TRIANGLE BLOCK
05600 HRL Y2,X2
05700 HRL Y3,X3
05800 MOVE AB2,LC
05900 MOVE AB3,C
06000 MOVE 2,13
06100 HRL 1,0
06200 HRL 3,14
06300 HRR 3,15
06400 MOVE 0,11
06500 EXCH 1,12
06600 EXCH 5,12
06700 MOVE 11,4
06800 MOVE 4,17
00100 ;BLIT BLOCK INTO LONG BLOCK TABLE.
00200 MOVE 17,NLEAST
00300 IMULI 17,13
00400 ADDI 17,TRIBLKS
00500 MOVE 16,17
00600 ADDI 16,12
00700 BLT 17,@16
00800 P3E:
00900 ;PUT TRIANGLE BLOCK POINTER INTO THE TRIANGLE TABLE
01000 ;IN ORDER ON MINIMUM DEPTH.
01100 HRL ZT,Z
01200 MOVE TRI,NUMTRI
01300 SKIPN LO,NLEAST
01400 JRST [AOS NLEAST ;FIRST TIME ONLY.
01500 MOVEM ZT,TRITAB-1(TRI)
01600 JRST LOOP]
01700 SETZ HI,
01800 PUT1: MOVE MID,LO ;MID:=(LO+HI+1)/2
01900 ADD MID,HI
02000 AOS MID
02100 ASH MID,-1
02200 MOVE LC,TRI ;FETCH Z(MID)
02300 SUB LC,MID
02400 HLRE A,TRITAB(LC)
02500 CAML Z,A
02600 JRST [CAMN LO,MID
02700 JRST PUT2
02800 CAMN HI,MID
02900 JRST PUT2
03000 MOVE LO,MID
03100 JRST PUT1]
03200 CAMN LO,MID
03300 JRST [AOS MID
03400 JRST PUT2]
03500 CAMN HI,LO
03600 JRST [AOS MID
03700 JRST PUT2]
03800 MOVE HI,MID
03900 JRST PUT1
04000
04100 ;MOVE THE LOWER PART OF THE TRIANGLE TABLE,
04200 ;BETWEEN NLEAST AND MID,
04300 ;DOWN CORE BY ONE WORD.
04400
04500 PUT2: CAMLE MID,NLEAST
04550 JRST PUT3
04575 MOVEI AC0,TRITAB
04600 ADD AC0,TRI
04700 MOVE AC1,AC0
04800 SUB AC0,NLEAST
04900 HRLS AC0
05000 SOS AC0
05100 SUB AC1,MID
05200 SOS AC1
05300 BLT AC0,@AC1
05400 PUT3: AOS NLEAST
05500 SUB TRI,MID
05600 MOVEM ZT,TRITAB(TRI)
05700 JRST LOOP
05800 END